Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/tab100/tab.bas

BASIC Source File | 1995-09-06 | 21KB | 795 lines

Sub TestForJack (Pv As Integer, Vp As String, Flag As Integer)
        If Pv = 12 Then
           Vp = "Y"
        End If
End Sub

Sub TestEqualRank (Pv As Integer, Vp As String, RCds As Integer)
    Dim i As Integer

    For i = 1 To TableNo
        If Pv = TableArray(i) Then
            Vp = "Y"
            NewTableArray(i) = 0
            RCds = RCds - 1
        End If
    Next i

End Sub

Sub TestEqualValue (Pv As Integer, Vp As String, RCds As Integer)

    Dim MatchFound As Integer
    Dim j As Integer
    Dim k As Integer

    For j = 1 To TableNo - 1
        For k = j + 1 To TableNo
            If Pv = TableArray(j) + TableArray(k) Then
                Vp = "Y"
                NewTableArray(j) = 0
                NewTableArray(k) = 0
                RCds = RCds - 2
                Exit Sub
            End If
            TestAsAces TableArray(j), TableArray(k), Pv, RCds, Vp, MatchFound
            If MatchFound = TRUE Then
                NewTableArray(j) = 0
                NewTableArray(k) = 0
                RCds = RCds - 2
                Exit Sub
            End If
        Next k
    Next j

End Sub

Sub TestForTypeOfPlay (Pv As Integer, Vp As String, Pos As Integer, RCds As Integer, TyOP As Integer)

    Dim i As Integer
    Dim SumRCds As Integer

    SumRCds = 0

    If Pv = 12 Then
        TyOP = JACK
        Exit Sub
    End If

    If RCds = 0 Then
        TyOP = TABLENETTE
        Exit Sub
    End If

    For i = 1 To TableNo
        SumRCds = SumRCds + NewTableArray(i)
    Next i

    If SumRCds = 12 Then
        TyOP = TOTAL_12
        Exit Sub
    End If

    If RCds = 1 Then
        If SumRCds > 11 Then
            SumRCds = SumRCds - 1
        End If
        If SumRCds = 11 Then
            SumRCds = 1
        End If
        Select Case EqualRankGone(SumRCds)
            Case 3
                TyOP = ONECARD_NOEQUAL
            Case 2
                TyOP = ONECARD_ONEEQUAL
            Case 1, 0
                Vp = ""
                TyOP = REJECTED_MOVE
        End Select
        Exit Sub
    End If


    If RCds >= 3 Then
        TyOP = THREECARDS_PLUS
    Else
        TyOP = TWOCARDS
    End If

End Sub

Sub AddToCardsTotal (Count As Integer)
    If GameSwitch = PLAYER_MOVE Then
        PlayerCardsNo = PlayerCardsNo + Count
    Else
        ComputerCardsNo = ComputerCardsNo + Count
    End If
End Sub

Sub AddToEqualRank (C1 As Integer)
    EqualRankGone(C1) = EqualRankGone(C1) + 1
End Sub

Sub AddToScore (C1 As Integer)

    Dim Score As Integer
    If GameSwitch = PLAYERMOVE Then
        Score = PSCore
        PickUpSwitch = PLAYER
    Else
        Score = CSCore
        PickUpSwitch = COMPUTER
    End If

    Select Case C1
        Case 1, 14, 27, 40          'Aces count 1
            Score = Score + 1
        Case 13, 26, 39, 52         'Kings count 1
            Score = Score + 1
        Case 12, 25, 38, 51         'Queens count 1
            Score = Score + 1
        Case 11, 24, 37, 50         'Jacks count 1
            Score = Score + 1
        Case 10, 23, 36             '10s except Diamonds score 1
            Score = Score + 1
        Case 49                     '10 Diamonds scores 2
            Score = Score + 2
        Case 28                     '2 Clubs scores 1
            Score = Score + 1
    End Select

    If GameSwitch = PLAYER_MOVE Then
        PSCore = Score
        If Val(Form1.PlayerScore.Caption) <> PSCore Then
            Form1.PlayerScore.Caption = Str$(PSCore)
        End If
    Else
        CSCore = Score
        If Val(Form1.ComputerScore.Caption) <> CSCore Then
            Form1.ComputerScore.Caption = Str$(CSCore)
        End If
    End If

End Sub

Sub AskForNewGame ()

    Dim MsgBoxResponse As Integer

    MsgBoxResponse = MsgBox("Do You Wish to Play Again", MBB_YNCAN + MBI_INFO)
    If MsgBoxResponse = MB_YES Then
        NewGame
        FirstDeal
    Else
        End
    End If
End Sub

Function BestComputerDiscard ()

    Dim i As Integer


    If TableNo = 0 Then
        DiscardOnZero
    Else
        If TableNo > 0 Then
            DiscardOnOne
        End If
    End If

    For i = 1 To 10
        For j = 1 To ComputerNo
                If TypeOfDiscard(j) = i Then
                    BestComputerDiscard = j
                    Exit Function
                End If
        Next j
    Next i


End Function

Function BestComputerMove ()
    Dim i As Integer
    Dim j As Integer

    Flag = False

    For i = 1 To 7
        For j = 1 To ComputerNo
            If ValidPlay(j) = "Y" Then
                If TypeOfPlay(j) = i Then
                    BestComputerMove = j
                    Flag = True
                    Exit Function
                End If
            End If
        Next j
    Next i

End Function

Sub CheckFor27Cards ()
    If PlayerCardsNo > 27 Then
        PSCore = PSCore + 3
        Form1.PlayerScore.Caption = Str$(PSCore)
    End If
    If ComputerCardsNo > 27 Then
        CSCore = CSCore + 3
        Form1.ComputerScore.Caption = Str$(CSCore)
    End If
End Sub

Function CheckForWin ()

    Flag = False

    If Val(Form1.PlayerScore.Caption) > 251 Then
        If Val(Form1.PlayerScore.Caption) > Val(Form1.ComputerScore.Caption) Then
            MsgBox ("Well done you've Won")
            CheckForWin = True
        Else
            MsgBox ("Computer Wins This Game")
            Flag = True
        End If
    Else
        If Val(Form1.ComputerScore.Caption) > 251 Then
            MsgBox ("Computer Wins This Game")
            CheckForWin = True
        End If
    End If

End Function

Sub CheckTableCards (A() As String, V As Integer, Pos As Integer, VNo As Integer)


    Dim TableVal As Integer
    Dim FirstCardVal As Integer
    Dim j As Integer


    TableVal = CardValue(Cards(Val(Form1.Picture1(Pos).Tag)))
    SetNewValue TableVal
    FirstCardVal = TableVal



    For j = Pos + 1 To TableNo
        TableVal = CardValue(Cards(Val(Form1.Picture1(j).Tag)))
        SetNewValue TableVal
        If V = FirstCardVal + TableVal Then
            A(VNo + 1) = Str$(Pos) + "," + Str$(j)
            VNo = VNo + 1
        Else
            CheckAcesAsOne FirstCardVal, TableVal, V, A(), Pos, j, VNo
        End If
    Next j

End Sub

Sub ClearValidPlays ()
    For i = 1 To 6
        ValidPlay(i) = ""
        TypeOfPlay(i) = 0
    Next i
End Sub

Sub DiscardOnOne ()

    Dim CompCard As Integer
    Dim TableCard As Integer
    Dim TwoCardVal  As Integer

    TableCard = CardValue(Cards(Val(Form1.Picture1(1).Tag)))
    SetNewValue TableCard


    For i = 1 To ComputerNo
        CompCard = CardValue(Cards(Val(Form1.Picture4(i).Tag)))
        SetNewValue CompCard

        If CompCard = TableCard Then
            TypeOfDiscard(i) = 10
        Else
            If CompCard + TableTotal = 12 Then
                If CompCard <> TableCard Then
                    TypeOfDiscard(i) = 1
                End If
            Else
                If CompCard + TableTotal > 14 Then
                    If CompCard <> TableCard Then
                        TypeOfDiscard(i) = 2
                    End If
                Else
                    Select Case EqualRankGone(CardValue(Cards(Val(Form1.Picture4(i).Tag))))
                        Case 3
                            TypeOfDiscard(i) = 3
                        Case 2
                            If CardValue(Cards(Val(Form1.Picture4(i).Tag))) < 7 Then
                                TypeOfDiscard(i) = 4
                            Else
                                TypeOfDiscard(i) = 5
                            End If
                        Case 1
                            If CardValue(Cards(Val(Form1.Picture4(i).Tag))) < 7 Then
                                TypeOfDiscard(i) = 6
                            Else